home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / database / postgres / postgre4.z / postgre4 / src / parser / parse_query.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-05-02  |  27.8 KB  |  1,119 lines
  1. /**********************************************************************
  2.  
  3.   parse_query.c
  4.  
  5.   -   All new code for Postquel, Version 2
  6.  
  7.   take an "optimizable" stmt and make the query tree that
  8.   the planner requires.
  9.  
  10.   Synthesizes the lisp object via routines in lisplib/lispdep.c
  11.   $Header: /private/postgres/src/parser/RCS/parse_query.c,v 1.101 1992/08/25 17:49:52 mer Exp $
  12.  **********************************************************************/
  13.  
  14. #include <ctype.h>
  15.  
  16. #include "tmp/postgres.h"
  17.  
  18. RcsId("$Header: /private/postgres/src/parser/RCS/parse_query.c,v 1.101 1992/08/25 17:49:52 mer Exp $");
  19.  
  20. #include "access/heapam.h"
  21. #include "access/tqual.h"
  22. #include "parser/parse.h"
  23. #include "utils/log.h"
  24. #include "utils/palloc.h"
  25. #include "utils/rel.h"         /* Relation stuff */
  26.  
  27. #include "nodes/pg_lisp.h"
  28. #include "nodes/primnodes.h"
  29. #include "nodes/primnodes.a.h"
  30.  
  31. #include "catalog/syscache.h"
  32. #include "catalogutils.h"
  33. #include "parse_query.h"
  34. #include "utils/lsyscache.h"
  35.  
  36. extern LispValue parser_ppreserve();
  37. extern int Quiet;
  38.  
  39. static ObjectId param_type_relid;
  40.  
  41. LispValue
  42. ModifyQueryTree(query,priority,ruletag)
  43.      LispValue query,priority,ruletag;
  44. {
  45.     return(lispString("rule query")); /* XXX temporary */
  46. }
  47.  
  48. /* kai: Moved this declaration from inside function to outside */
  49. extern LispValue p_rtable;
  50.  
  51. Name
  52. VarnoGetRelname( vnum )
  53.      int vnum;
  54. {
  55.     int i;
  56.     LispValue temp = p_rtable;
  57.     for( i = 1; i < vnum ; i++) 
  58.         temp = CDR(temp);
  59.     return((Name)CString(CAR(CDR(CAR(temp)))));
  60. }
  61.  
  62. LispValue
  63. any_ordering_op( resdom )
  64.     Resdom resdom;
  65. {
  66.     int restype;
  67.     Operator order_op;
  68.     OID order_opid;
  69.  
  70.     Assert(! null(resdom));
  71.  
  72.     restype = get_restype(resdom);
  73.     order_op = oper("<",restype,restype);
  74.     order_opid = (OID)oprid(order_op);
  75.  
  76.     return(lispInteger(order_opid));
  77.  
  78. }
  79.  
  80. Resdom
  81. find_tl_elt ( varname ,tlist )
  82.      char *varname;
  83.      List tlist;
  84. {
  85.     LispValue i = LispNil;
  86.  
  87.     foreach ( i, tlist ) {
  88.     Resdom resnode = (Resdom)CAAR(i);
  89.     /* Var tvarnode = (Var) CADR(CAR(i));*/
  90.     Name resname = get_resname(resnode );
  91.  
  92.     if ( ! strcmp ( resname, varname ) ) {
  93.         return ( resnode );
  94.     } 
  95.     }
  96.     return ( (Resdom) NULL );
  97. }
  98.  
  99. /**************************************************
  100.   MakeRoot
  101.   
  102.   lispval :
  103.       ( NumLevels NIL )
  104.       |   ( NumLevels RETRIEVE ( PORTAL "result" ) )
  105.       |   ( NumLevels RETRIEVE ( RELATION "result" ) )
  106.       |   ( NumLevels OtherOptStmt rt_index )
  107.       
  108.   where rt_index = index into range_table
  109.   
  110.   **************************************************/
  111.  
  112. LispValue
  113. MakeRoot(NumLevels,query_name,result,rtable,priority,ruleinfo,unique_flag,
  114.      sort_clause,targetlist)
  115.      int NumLevels;
  116.      LispValue query_name,result;
  117.      LispValue rtable,priority,ruleinfo;
  118.      LispValue unique_flag,sort_clause;
  119.      LispValue targetlist;
  120. {
  121.     LispValue newroot = LispNil;
  122.     LispValue new_sort_clause = LispNil;
  123.     LispValue sort_clause_elts = LispNil;
  124.     LispValue sort_clause_ops = LispNil;
  125.     LispValue i = LispNil;
  126.  
  127.     foreach (i, sort_clause) {
  128.  
  129.     LispValue     one_sort_clause = CAR(i);
  130.     Resdom         one_sort_elt = NULL;
  131.     String         one_sort_op = NULL;
  132.     int         sort_elt_type = 0;
  133.  
  134.     Assert ( consp (one_sort_clause) );
  135.  
  136.     one_sort_elt = find_tl_elt(CString(CAR(one_sort_clause)),targetlist );
  137.  
  138.     if ( null (one_sort_elt))
  139.       elog(WARN,"The field being sorted by must appear in the target list");
  140.  
  141.     if ( ! null ( CADR ( one_sort_clause )))
  142.       one_sort_op = CString(CADR(one_sort_clause));
  143.     else
  144.       one_sort_op = "<";
  145.  
  146.     /* Assert ( tlelementP (one_sort_elt) ); */
  147.  
  148.     sort_clause_elts = nappend1(sort_clause_elts, (LispValue)one_sort_elt);
  149.     sort_elt_type = get_restype(one_sort_elt);
  150.  
  151.     sort_clause_ops = nappend1( sort_clause_ops,
  152.                    lispInteger(oprid( oper(one_sort_op,
  153.                                sort_elt_type,
  154.                                sort_elt_type ) )));
  155.     }
  156.         
  157.     if ( unique_flag != LispNil ) {
  158.     /* concatenate all elements from target list
  159.        that are not already in the sortby list */
  160.         foreach (i,targetlist) {
  161.         LispValue tlelt = CAR(i);
  162.         if ( ! member ( CAR(tlelt) , sort_clause_elts ) ) {
  163.         sort_clause_elts = nappend1 ( sort_clause_elts, CAR(tlelt)); 
  164.         sort_clause_ops = nappend1 ( sort_clause_ops, 
  165.             any_ordering_op((Resdom)CAR(tlelt) ));
  166.         }
  167.     }    
  168.     }
  169.  
  170.     if ( sort_clause_elts != LispNil && sort_clause_ops != LispNil ) {
  171.         new_sort_clause = lispCons ( lispAtom("sort"),
  172.                      lispCons (sort_clause_elts, 
  173.                                lispCons (sort_clause_ops, 
  174.                              LispNil ))); 
  175.     }
  176.  
  177.     newroot = lispCons (new_sort_clause,LispNil);
  178.     newroot = lispCons (unique_flag,newroot );
  179.     newroot = lispCons( ruleinfo , newroot );
  180.     newroot = lispCons( priority , newroot );
  181.     newroot = lispCons( rtable , newroot );
  182.     newroot = lispCons( result , newroot );
  183.     newroot = lispCons( query_name, newroot );
  184.     newroot = lispCons( lispInteger( NumLevels ) , newroot );
  185.  
  186.     return (newroot) ;
  187. }
  188.  
  189.  
  190. /**************************************************
  191.   
  192.   MakeRangeTableEntry :
  193.   INPUT:
  194.   <relname>
  195.   OUTPUT:
  196.   ( <relname> <relnum> <time> <flags> <rulelocks> )
  197.  
  198.   NOTES:
  199.     (eq CAR(options) , Trange)
  200.     (eq CDR(optioons) , flags )
  201.  
  202.  **************************************************/
  203.  
  204. LispValue
  205. MakeRangeTableEntry( relname , options , refname)
  206.      Name relname;
  207.      List options;
  208.      Name refname;
  209. {
  210.     LispValue entry     = LispNil,
  211.     RuleLocks     = LispNil,
  212.     Flags     = LispNil,
  213.     TRange    = LispNil,
  214.     RelOID    = LispNil;
  215.     Relation relation;
  216.     
  217.     relation = heap_openr(relname);
  218.     if (relation == NULL) {
  219.     elog(WARN,"heap_openr on %s failed\n",relname);
  220.     }
  221.     
  222.     /* RuleLocks - for now, always empty, since preplanner fixes */
  223.     
  224.     /* Flags - zero or more from archive,inheritance,union,version
  225.                or recursive (transitive closure) */
  226.  
  227.     if (consp(options)) { 
  228.       Flags = CDR(options);
  229.       TRange = CAR(options);
  230.     } else {
  231.       Flags = LispNil;
  232.       TRange = lispInteger(0);
  233.     }
  234.  
  235.     /* RelOID */
  236.     RelOID = lispInteger ( RelationGetRelationId (relation ));
  237.     
  238.     entry = lispCons (lispString(&relname->data[0]), 
  239.               lispCons(RelOID,
  240.                    lispCons(TRange,
  241.                         lispCons(Flags,
  242.                              lispCons(RuleLocks,
  243.                                   LispNil)))));
  244.     /*
  245.      * close the relation we're done with it for now.
  246.      */
  247.     heap_close(relation);
  248.     return ( lispCons ( lispString(&refname->data[0]), entry ));
  249. }
  250.  
  251. /**************************************************
  252.  
  253.   ExpandAll
  254.  
  255.       - makes a list of attributes
  256.     - assumes reldesc caching works
  257.   **************************************************/
  258.  
  259. LispValue
  260. ExpandAll(relname,this_resno)
  261.      Name relname;
  262.      int *this_resno;
  263. {
  264.     Relation rdesc;
  265.     LispValue tall = LispNil;
  266.     Resdom resnode;
  267.     Var varnode;
  268.     LispValue temp = LispNil;
  269.     int i,maxattrs,first_resno;
  270.     int type_id,type_len,vnum;
  271.     Name physical_relname;
  272.  
  273.     first_resno = *this_resno;
  274.     
  275.     /* printf("\nExpanding %s.all\n",relname); */
  276.     vnum = RangeTablePosn (relname,0);
  277.     if ( vnum == 0 ) {
  278.         p_rtable = nappend1 ( p_rtable,
  279.                      MakeRangeTableEntry (relname, 
  280.                               0 ,  relname));
  281.         vnum = RangeTablePosn (relname,0);
  282.     }
  283.  
  284.     physical_relname = VarnoGetRelname(vnum);
  285.  
  286.  
  287.     rdesc = heap_openr(physical_relname);
  288.     
  289.     if (rdesc == NULL ) {
  290.         elog(WARN,"Unable to expand all -- heap_openr failed ");
  291.         return( LispNil );
  292.     }
  293.     maxattrs = RelationGetNumberOfAttributes(rdesc);
  294.  
  295.     for ( i = maxattrs-1 ; i > -1 ; --i ) {
  296.         char *attrname;
  297.  
  298.         attrname = (char *) palloc (sizeof(NameData)+1);
  299.         strcpy(attrname, (char *)(&rdesc->rd_att.data[i]->attname));
  300.         temp = make_var ( relname, (Name) attrname);
  301.         varnode = (Var)CDR(temp);
  302.         type_id = CInteger(CAR(temp));
  303.         type_len = (int)tlen(get_id_type(type_id));
  304.         
  305.         resnode = MakeResdom((AttributeNumber) i + first_resno, 
  306.                      (ObjectId)type_id, 
  307.                      ISCOMPLEX(type_id),
  308.                      (Size)type_len,
  309.                      (Name) attrname, 
  310.                      (Index)0, (OperatorTupleForm)0, 0 );
  311. /*
  312.         tall = lispCons(lispCons(resnode, lispCons(varnode, LispNil)),
  313.                 tall);
  314. */
  315.         tall = lispCons(lispCons((LispValue)resnode,
  316.                      lispCons((LispValue)varnode,LispNil)),
  317.                 tall);
  318.     }
  319.  
  320.     /*
  321.      * Close the reldesc - we're done with it now
  322.      */
  323.     heap_close(rdesc);
  324.     *this_resno = first_resno + maxattrs;
  325.     return(tall);
  326. }
  327.  
  328. LispValue
  329. MakeTimeRange( datestring1 , datestring2 , timecode )
  330.      LispValue datestring1, datestring2;
  331.      int timecode; /* 0 = snapshot , 1 = timerange */
  332. {
  333.     TimeQual    qual;
  334.     Time t1,t2;
  335.  
  336.     switch (timecode) {
  337.         case 0:
  338.             if (datestring1 == LispNil) {
  339.                 elog(WARN, "MakeTimeRange: bad snapshot arg");
  340.             }
  341.             t1 = nabstimein(CString(datestring1));
  342.             if (!AbsoluteTimeIsValid(t1)) {
  343.                 elog(WARN, "bad snapshot time: \"%s\"",
  344.                     CString(datestring1));
  345.             }
  346.             qual = TimeFormSnapshotTimeQual(t1);
  347.             break;
  348.         case 1:
  349.             if (datestring1 == LispNil) {
  350.                 t1 = InvalidAbsoluteTime;
  351.             } else {
  352.                 t1 = nabstimein(CString(datestring1));
  353.                 if (!AbsoluteTimeIsValid(t1)) {
  354.                     elog(WARN,
  355.                         "bad range start time: \"%s\"",
  356.                         CString(datestring1));
  357.                 }
  358.             }
  359.             if (datestring2 == LispNil) {
  360.                 t2 = InvalidAbsoluteTime;
  361.             } else {
  362.                 t2 = nabstimein(CString(datestring2));
  363.                 if (!AbsoluteTimeIsValid(t2)) {
  364.                     elog(WARN,
  365.                         "bad range end time: \"%s\"",
  366.                         CString(datestring2));
  367.                 }
  368.             }
  369.             qual = TimeFormRangedTimeQual(t1,t2);
  370.             break;
  371.         default:
  372.             elog(WARN, "MakeTimeRange: internal parser error");
  373.     }
  374.     return(lispInteger((int)qual));
  375. }
  376.  
  377. void
  378. disallow_setop(op, optype, operand)
  379.     LispValue op;
  380.     Type optype;
  381.     LispValue operand;
  382. {
  383.     if (lispNullp(operand))
  384.     return;
  385.  
  386.     if (IsA(operand,Iter)) {
  387.     elog(NOTICE, "An operand to the '%s' operator returns a set of %s,",
  388.              LISPVALUE_STRING(op), tname(optype));
  389.     elog(WARN, "but '%s' takes single values, not sets.",
  390.              LISPVALUE_STRING(op));
  391.     }
  392. }
  393.  
  394. LispValue 
  395. make_op(op,ltree,rtree, optype)
  396.      LispValue op,ltree,rtree;
  397.      char optype;
  398. {
  399.     Type ltype,rtype;
  400.     Operator temp;
  401.     OperatorTupleForm opform, optemp;
  402.     Oper newop;
  403.     LispValue left,right;
  404.     LispValue t1;
  405.     ObjectId fid;
  406.  
  407.     if ( optype == 'r' ) {
  408.     /* right operator */
  409.         if (lispNullp(ltree))
  410.         elog(WARN, "NULL not allowed with this operator type");
  411.         left = CDR(ltree);
  412.         right = LispNil;
  413.         if (! lispNullp(left)) {
  414.         ltype = get_id_type ( CInteger ( CAR(ltree) ));
  415.         disallow_setop(op, ltype, left);
  416.         }
  417.         temp = right_oper( CString( op ), typeid(ltype));
  418.      } else if (optype == 'l') {
  419.         /* left operator */
  420.         if (lispNullp(rtree))
  421.         elog(WARN, "NULL not allowed with this operator type");
  422.         right = CDR(rtree);
  423.         left = right;
  424.         if (! lispNullp(right)) {
  425.         rtype = get_id_type ( CInteger ( CAR(rtree) ) );
  426.         disallow_setop(op, rtype, right);
  427.         }
  428.         temp = left_oper( CString( op ), typeid(rtype) );
  429.         right = LispNil;
  430.     } else {
  431.         /* binary operator */
  432.         if (lispNullp(ltree)) {
  433.         elog(WARN, "NULL not allowed with this operator type");
  434.         } else {
  435.         left = CDR(ltree);
  436.         ltype = get_id_type ( CInteger ( CAR(ltree) ));
  437.  
  438.         disallow_setop(op, ltype, left);
  439.  
  440.         if (! lispNullp(rtree)) {
  441.             right = CDR(rtree);
  442.             rtype = get_id_type ( CInteger ( CAR(rtree) ) );
  443.             disallow_setop(op, rtype, right);
  444.             if (typeid(rtype) == typeid(type("unknown"))) {
  445.             /* trying to find default type for the right arg... */
  446.             temp = (Operator) oper_default(CString(op),
  447.                             typeid(ltype));
  448.             /* now, we have the default type, typecast */
  449.             if(temp){
  450.             Datum val;
  451.             val = textout((struct varlena *)
  452.                        get_constvalue((Const)right));
  453.             optemp = (OperatorTupleForm) GETSTRUCT(temp);
  454.             right = (LispValue) MakeConst(optemp->oprright,
  455.                     tlen(get_id_type(optemp->oprright)),
  456.                     (Datum)fmgr(typeid_get_retinfunc(optemp->oprright),val),
  457.                     false, true /*XXX was omitted */);
  458.             } else
  459.                 op_error(CString(op), typeid(ltype), typeid(rtype));
  460.                 
  461.             } else
  462.             temp = oper(CString(op),typeid(ltype), typeid ( rtype ));
  463.         } else {
  464.             /* Right Operator is NULL */
  465.                     temp = (Operator) oper_default(CString(op),typeid(ltype));
  466.                     if(temp){
  467.                         optemp = (OperatorTupleForm) GETSTRUCT(temp);
  468.                         right = (LispValue) MakeConst(optemp->oprright, 0,
  469.                          (Datum)(struct varlena *)NULL,
  470.                     true, true );
  471.                      } else 
  472.             op_error(CString(op), typeid(ltype), typeid(rtype));
  473.         }
  474.         }
  475.     }
  476.     opform = (OperatorTupleForm) GETSTRUCT(temp);
  477.  
  478.     newop = MakeOper ( oprid(temp),    /* opno */
  479.                 InvalidObjectId,    /* opid */
  480.                 0 ,                /* operator relation level */
  481.                 opform->oprresult, /* operator result type */
  482.                 NULL, NULL);
  483.     if (!left)
  484.         t1 = lispCons ( (LispValue)newop , lispCons (right,LispNil) );
  485.     else if (!right)
  486.         t1 = lispCons ( (LispValue)newop , lispCons (left,LispNil) );
  487.     else
  488.         t1 = lispCons ( (LispValue)newop , lispCons (left ,
  489.                          lispCons (right,LispNil)));
  490.     return ( lispCons (lispInteger ( opform->oprresult ) ,
  491.                t1 ));
  492. } /* make_op */
  493.  
  494. /*
  495.  * make_concat_var
  496.  * 
  497.  * for the relational "concatenation" operator
  498.  * a real relational union is too expensive since 
  499.  * a union b = a + b - ( a intersect b )
  500.  */
  501.  
  502. List 
  503. make_concat_var ( list_of_varnos , attid , vartype)
  504.      List list_of_varnos;
  505.      int attid;
  506.      int vartype;
  507. {
  508.     List retval = NULL;
  509.     List temp = NULL;
  510.     Var varnode;
  511.  
  512.     foreach ( temp , list_of_varnos ) {
  513.     LispValue each_varno = CAR(temp);
  514.     int vnum;
  515.  
  516.     vnum = CInteger(each_varno);
  517.     varnode = MakeVar (vnum , attid ,
  518.                vartype ,
  519.                lispCons(lispInteger(vnum),
  520.                     lispCons(lispInteger(attid),LispNil)),
  521.                0 );
  522.     retval = lispCons ( (LispValue)varnode , retval );
  523.     }
  524.     retval = lispCons ( lispAtom ( "union" ), retval );
  525.     return(retval);
  526. }
  527.  
  528. LispValue
  529. fix_param(l)
  530.      LispValue l;
  531. {
  532.     Param p;
  533.     ObjectId relid;
  534.     Name attrname;
  535.  
  536.     p = (Param)CAR(l);
  537.     relid = get_paramtype(p);
  538.     attrname = (Name)CString(CADR(l));
  539.  
  540.     return (lispCons(lispInteger(find_atttype(relid, attrname)),
  541.                (LispValue) l));
  542. }
  543.  
  544. find_atttype(relid, attrname)
  545.     ObjectId relid;
  546.     Name attrname;
  547. {
  548.     int attid, vartype;
  549.     Relation rd;
  550.  
  551.     rd = heap_open(relid);
  552.     if (!RelationIsValid(rd)) {
  553.     rd = heap_openr(tname(get_id_type(relid)));
  554.     if (!RelationIsValid(rd))
  555.         elog(WARN, "cannot compute type of att %s for relid %d",
  556.             attrname, relid);
  557.     }
  558.  
  559.     attid =  nf_varattno(rd, (char *) attrname);
  560.  
  561.     if (attid == InvalidAttributeNumber) 
  562.         elog(WARN, "Invalid attribute %s\n", attrname);
  563.  
  564.     vartype = att_typeid(rd , attid);
  565.  
  566.     /*
  567.      * close relation we're done with it now
  568.      */
  569.     amclose(rd);
  570.  
  571.     return (vartype);
  572. }
  573.  
  574. /**********************************************************************
  575.   make_var
  576.  
  577.   - takes the attribute and figures out the 
  578.   info necessary for constructing a varnode
  579.  
  580.   attribute = (relname . attrname)
  581.  
  582.   - returns a type,varnode pair suitable for use in arith-expr's
  583.   to get just the varnode, strip the type off (use CDR(make_var ..) )
  584.  **********************************************************************/
  585.  
  586. LispValue
  587. make_var ( relname, attrname)
  588.      Name relname, attrname;
  589. {
  590.     Var varnode;
  591.     int vnum, attid, vartype;
  592.     Type rtype;
  593.     Relation rd;
  594.     extern LispValue p_rtable;
  595.     extern int p_last_resno;
  596.     extern List RangeTablePositions();
  597.     List multi_varnos = RangeTablePositions ( relname , 0 );
  598.     ObjectId relid,check;
  599.  
  600.     vnum = RangeTablePosn ( relname,0) ;
  601.  
  602.     if (vnum == 0) {
  603.     p_rtable = nappend1 (p_rtable ,
  604.                  MakeRangeTableEntry ( relname , 0 , relname) );
  605.         vnum = RangeTablePosn (relname,0);
  606.     /* printf("vnum = %d\n",vnum); */
  607.     relname = VarnoGetRelname(vnum);
  608.     } else {
  609.     relname = VarnoGetRelname( vnum );
  610.     }
  611.     
  612.     rd = amopenr ( relname );
  613.     relid = RelationGetRelationId(rd);
  614.     attid =  nf_varattno(rd, (char *) attrname);
  615.     if (attid == InvalidAttributeNumber) 
  616.       elog(WARN, "Invalid attribute %s\n", attrname);
  617.     vartype = att_typeid ( rd , attid );
  618.     rtype = get_id_type(vartype);
  619.  
  620.     varnode = MakeVar (vnum , attid ,
  621.                        vartype ,
  622.                        lispCons(lispInteger(vnum),
  623.                                 lispCons(lispInteger(attid),LispNil)), 0);
  624.  
  625.     /*
  626.      * close relation we're done with it now
  627.      */
  628.     amclose(rd);
  629.     /*
  630.      * for now at least, attributes of concatenated relations will not have
  631.      * procedural fields or arrays. This can be changed later.
  632.      * We also assume that they have identical schemas
  633.      */
  634.  
  635.     if ( length ( multi_varnos ) > 1 )
  636.       return ( lispCons ( lispInteger ( typeid (rtype)),
  637.              make_concat_var ( multi_varnos , attid , vartype)));
  638.  
  639.     return ( lispCons ( lispInteger ( typeid (rtype ) ),
  640.                (LispValue)varnode ));
  641. }
  642. /*
  643.  *  make_array_ref() -- Make an array reference node.
  644.  *
  645.  *    Array references can hang off of arbitrary nested dot (or
  646.  *    function invocation) expressions.  This routine takes a
  647.  *    tree generated by ParseFunc() and an array index and
  648.  *    generates a new array reference tree.  We do some simple
  649.  *    typechecking to be sure the dereference is valid in the
  650.  *    type system, but we don't do any bounds checking here.
  651.  *
  652.  *    For the current release, only single-dimension arrays are
  653.  *    supported.
  654.  */
  655.  
  656. LispValue
  657. make_array_ref(expr, indexpr)
  658.      LispValue expr;
  659.      LispValue indexpr;
  660. {
  661.     ObjectId typearray;
  662.     HeapTuple type_tuple;
  663.     TypeTupleForm type_struct_array, type_struct_element;
  664.     ArrayRef aref;
  665.  
  666.     typearray = (ObjectId) CInteger(CAR(expr));
  667.  
  668.     type_tuple = SearchSysCacheTuple(TYPOID, typearray, NULL, NULL, NULL);
  669.  
  670.     if (!HeapTupleIsValid(type_tuple))
  671.     elog(WARN, "make_array_ref: Cache lookup failed for type %d\n",
  672.          typearray);
  673.  
  674.     /* get the array type struct from the type tuple */
  675.     type_struct_array = (TypeTupleForm) GETSTRUCT(type_tuple);
  676.  
  677.     if (type_struct_array->typelem == InvalidObjectId) {
  678.     elog(WARN, "make_array_ref: type %s is not an array",
  679.         (Name)&(type_struct_array->typname.data[0]));
  680.     }
  681.  
  682.     /* get the type tuple for the element type */
  683.     type_tuple = SearchSysCacheTuple(TYPOID, type_struct_array->typelem,
  684.                      NULL, NULL, NULL);
  685.  
  686.     if (!HeapTupleIsValid(type_tuple))
  687.         elog(WARN, "make_array_ref: Cache lookup failed for type %d\n",
  688.          typearray);
  689.  
  690.     type_struct_element = (TypeTupleForm) GETSTRUCT(type_tuple);
  691.  
  692.     aref = (ArrayRef) MakeArrayRef(type_struct_array->typlen,
  693.                    type_struct_element->typlen,
  694.                    type_struct_array->typelem,
  695.                    type_struct_element->typbyval,
  696.                    CDR(indexpr),
  697.                    CDR(expr));
  698.  
  699.     return (lispCons(lispInteger(get_refelemtype(aref)),
  700.              (LispValue)aref));
  701. }
  702.  
  703. /**********************************************************************
  704.   SkipToFromList
  705.  
  706.   - employ lookahead to see if there is indeed a from_list
  707.   ahead of us.  If so, skip to it and continue processing
  708.  
  709.  **********************************************************************/
  710.  
  711. /*
  712. static char tlist_buf[1024];
  713. static int end_tlist_buf = 0;
  714. */
  715. static char *target_list_place;
  716.  
  717. extern char *Ch, *InputFrag;
  718. extern char *CurScan();
  719. extern int FragLen;
  720.  
  721. SkipForwardToFromList()
  722. {
  723.         LispValue next_token;
  724.         char *temp = CurScan();
  725.  
  726.     /*
  727.      * kai: Don't deliver a from clause, if the scanner hasn't passed beyond
  728.      *      the last from clause yet.
  729.      */
  730.     if(temp < InputFrag)
  731.         return;
  732.  
  733.         /*
  734.          * kai: I don't really know, what to do: the former behaviour of this
  735.          *      was, that it finds any from clause, whether or not it belongs
  736.          *      to the same postquel statement. Changed it to stop scan at
  737.          *      any append, delete, replace or retrieve, seems to work, but is
  738.          *      different from original behaviour ...
  739.          */
  740.         while ((int)(next_token=(LispValue)yylex()) > 0 &&
  741.                 next_token != (LispValue)FROM &&
  742.                 next_token != (LispValue)APPEND &&
  743.                 next_token != (LispValue)DELETE &&
  744.                 next_token != (LispValue)REPLACE &&
  745.                 next_token != (LispValue)RETRIEVE )
  746.           ; /* empty while */
  747.  
  748.         if (next_token == (LispValue) FROM ) {
  749.                 Ch = CurScan() - 4;
  750.                 FragLen = Ch - temp;
  751.                 target_list_place = temp;
  752.  
  753.         } else {
  754.                 Ch = temp;
  755.         }
  756.  
  757.  
  758.     NewInput();
  759. }
  760.  
  761. LispValue
  762. SkipBackToTlist()
  763. {
  764.     extern LispValue yychar;
  765.     extern int yyleng;
  766.     int i;
  767.  
  768.     /* need to put the token after the target_list back first */
  769.     Ch = CurScan();
  770.     if((yychar == (LispValue)WHERE) || (yychar == (LispValue)SORT))
  771.         Ch -= yyleng;
  772.  
  773.     InputFrag = target_list_place;
  774.     NewInput();
  775.     return(LispNil);
  776. }
  777.  
  778. LispValue
  779. SkipForwardPastFromList()
  780. {
  781. return(LispNil);    
  782. }
  783.  
  784. StripRangeTable()
  785. {
  786.     LispValue temp;
  787.     temp = p_rtable;
  788.     
  789.     while(! lispNullp(temp) ) {
  790.         char *from_name = CString(CAR(CAR(temp)));
  791.  
  792.         /*
  793.          * for current or new, we need
  794.          * a marker to be present
  795.          */
  796.  
  797.         if ((!strcmp ( from_name, "*CURRENT*")) ||
  798.         (!strcmp ( from_name, "*NEW*")) )
  799.           CAR(CDR(CAR(temp))) = CAR(CAR(temp));
  800.         
  801.         CAR(temp) = CDR (CAR (temp));
  802.         temp = CDR(temp);
  803.     }
  804. }
  805.  
  806. /**********************************************************************
  807.  
  808.   make_const
  809.  
  810.   - takes a lispvalue, (as returned to the yacc routine by the lexer)
  811.   extracts the type, and makes the appropriate type constant
  812.   by invoking the (c-callable) lisp routine c-make-const
  813.   via the lisp_call() mechanism
  814.  
  815.   eventually, produces a "const" lisp-struct as per nodedefs.cl
  816.   
  817.  **********************************************************************/
  818. LispValue
  819. make_const( value )
  820.      LispValue value;
  821. {
  822.     Type tp;
  823.     LispValue temp;
  824.     Datum val;
  825.  
  826.     switch( value->type ) {
  827.       case PGLISP_INT:
  828.         tp = type("int4");
  829.         val = Int32GetDatum(value->val.fixnum);
  830.         break;
  831.         
  832.       case PGLISP_ATOM:
  833.         tp = type("char");
  834.         val = PointerGetDatum(value->val.name);
  835.         break;
  836.         
  837.       case PGLISP_FLOAT:
  838.         {
  839.         float64 dummy;
  840.         tp = type("float8");
  841.          
  842.         dummy = (float64)palloc(sizeof(float64data));
  843.         *dummy = value->val.flonum;
  844.         
  845.         val = Float64GetDatum(dummy);
  846.         }
  847.         break;
  848.         
  849.       case PGLISP_STR:
  850.               tp = type("unknown"); /* unknown for now, will be type coerced */
  851.               val = PointerGetDatum(textin(value->val.str));
  852.             break;
  853.         
  854.       default: 
  855.         elog(NOTICE,"unknown type : %d\n", value->type );
  856.         /* null const */
  857.         return ( lispCons (LispNil , 
  858.                    (LispValue)MakeConst ( (ObjectId)0 , (Size)0 , 
  859.                       (Datum)LispNil , 1, 0/*ignored*/ )) );
  860.     }
  861.  
  862.     temp = lispCons (lispInteger ( typeid (tp)) ,
  863.               (LispValue)MakeConst(typeid( tp ), tlen( tp ),
  864.                     val , false, tbyval(tp) ));
  865. /*    lispDisplay( temp , 0 );*/
  866.     return (temp);
  867.     
  868. }
  869. LispValue
  870. parser_ppreserve(temp)
  871.      char *temp;
  872. {
  873.     return((LispValue)temp);
  874. }
  875.  
  876. /*-------------------------------------------------------------------
  877.  *
  878.  * make_param
  879.  * Creates a Param node. This routine is called when a 'define rule'
  880.  * statement contains references to the 'current' and/or 'new' tuple.
  881.  * 
  882.  * paramKind:
  883.  *    One of the possible param kinds (PARAM_NEW, PARAM_OLD, etc)
  884.  *     (see lib/H/primnodes.h)
  885.  * relationName:
  886.  *     the name of the relation where 'attrName' belongs.
  887.  *    this is not stored anywhere in the Param node, but we
  888.  *     need it in order to infer the type of the parameter
  889.  *     and to do some checking....
  890.  * attrName:
  891.  *    the name of the attribute whose value will be substituted
  892.  *    (at rule activation time) in the place of this param
  893.  *     node.
  894.  */
  895. LispValue
  896. make_param(paramKind, relationName, attrName)
  897. int paramKind;
  898. char *relationName;
  899. char *attrName;
  900. {
  901.     LispValue result;
  902.     Relation relation;
  903.     int attrNo;
  904.     ObjectId attrType;
  905.     Name name;
  906.     Param paramNode;
  907.  
  908.     /*
  909.      * open the relation
  910.      */
  911.     relation = heap_openr(relationName);
  912.     if (relation == NULL) {
  913.     elog(WARN,"make_param: can not open relation '%s'",relationName);
  914.     }
  915.     
  916.     /*
  917.      * find the attribute number and type
  918.      */
  919.     attrNo = varattno(relation, attrName);
  920.     attrType = att_typeid(relation, attrNo);
  921.  
  922.     /*
  923.      * create the Param node
  924.      */
  925.     name = (Name) palloc(sizeof(NameData));
  926.     if (name == NULL) {
  927.     elog(WARN, "make_param: out of memory!\n");
  928.     }
  929.     strcpy(&(name->data[0]), attrName);
  930.  
  931.     paramNode = MakeParam(paramKind,    /* paramkind */
  932.             attrNo,        /* paramid - i.e. attrno */
  933.             name,        /* paramname */
  934.             attrType,    /* paramtype */
  935.             (List) NULL);    /* param_tlist */
  936.     
  937.     /*
  938.      * close the relation - we're done with it now
  939.      */
  940.     heap_close(relation);
  941.  
  942.     /*
  943.      * form the final result (a list of the parameter type and
  944.      * the Param node)
  945.      */
  946.     result = lispCons(lispInteger(attrType), (LispValue)paramNode);
  947.     return(result);
  948.             
  949. }
  950. /*
  951.  * param_type_init()
  952.  *
  953.  * keep enough information around fill out the type of param nodes
  954.  * used in postquel functions
  955.  */
  956.  
  957. void param_type_init(typev, nargs)
  958.     ObjectId *typev;
  959.     int nargs;
  960. {
  961.     int y=0,z;
  962.     List i,x,args = LispNil;
  963.  
  964.     pfunc_num_args = nargs;
  965.     param_type_info = typev;
  966. }
  967.  
  968. ObjectId param_type(t)
  969.      int t;
  970. {
  971.     if ((t >pfunc_num_args) ||(t ==0)) return InvalidObjectId;
  972.     return param_type_info[t-1];
  973. }
  974.  
  975. ObjectId param_type_complex(n)
  976.      Name n;
  977. {
  978.     if (!param_type_relid) return InvalidObjectId;
  979.     return get_atttype(param_type_relid, get_attnum(param_type_relid, n));
  980. }
  981.  
  982.  
  983. /*--------------------------------------------------------------------
  984.  * FindVarNodes
  985.  *
  986.  * Find all the Var nodes of a parse tree
  987.  *
  988.  * NOTE #1: duplicates are not removed
  989.  * NOTE #2: we do not make copies of the Var nodes.
  990.  *
  991.  *--------------------------------------------------------------------
  992.  */
  993. LispValue
  994. FindVarNodes(list)
  995. LispValue list;
  996. {
  997.     List i, t;
  998.     List result;
  999.     List tempResult;
  1000.  
  1001.     result = LispNil;
  1002.  
  1003.     foreach (i , list) {
  1004.     List temp = CAR(i);
  1005.     if ( temp && IsA (temp,Var) ) {
  1006.         result = lispCons(temp, result);
  1007.     } 
  1008.     if (  temp && temp->type == PGLISP_DTPR ) {
  1009.        tempResult = FindVarNodes(temp);
  1010.        /*
  1011.         * I shoud have used 'append1' but it has a bug!
  1012.         */
  1013.        foreach(t, tempResult)
  1014.            result = lispCons(CAR(t), result); 
  1015.     }
  1016.     }
  1017.  
  1018.     return(result);
  1019. }
  1020.  
  1021. /*--------------------------------------------------------------------
  1022.  *
  1023.  * IsPlanUsingNewOrCurrent
  1024.  *
  1025.  * used to find if a plan references the 'NEW' or 'CURRENT'
  1026.  * relations.
  1027.  *--------------------------------------------------------------------
  1028.  */
  1029.  
  1030. void
  1031. IsPlanUsingNewOrCurrent(parsetree, currentUsed, newUsed)
  1032. List parsetree;
  1033. bool *currentUsed;
  1034. bool *newUsed;
  1035. {
  1036.     List varnodes;
  1037.     List i;
  1038.     Var v;
  1039.  
  1040.     /*
  1041.      * first find the varnodes referenced in this parsetree
  1042.      */
  1043.     varnodes = FindVarNodes(parsetree);
  1044.  
  1045.     *currentUsed = false;
  1046.     *newUsed = false;
  1047.  
  1048.     foreach(i, varnodes) {
  1049.     v = (Var) CAR(i);
  1050.     if (get_varno(v) == 1)
  1051.         *currentUsed = true;
  1052.     if (get_varno(v) == 2)
  1053.         *newUsed = true;
  1054.     }
  1055. }
  1056.  
  1057.  
  1058. /*--------------------------------------------------------------------
  1059.  *
  1060.  * SubstituteParamForNewOrCurrent
  1061.  *
  1062.  * Change all the "Var" nodes corresponding to the NEW & CURRENT relation
  1063.  * to the equivalent "Param" nodes.
  1064.  *
  1065.  * NOTE: this routine used to be called from the parser, but now it is
  1066.  * called from the tuple-level rule system (when defining a rule),
  1067.  * and it takes an extra argument (the relation oid for the
  1068.  * NEW/CURRENT relation.
  1069.  * 
  1070.  *--------------------------------------------------------------------
  1071.  */
  1072. SubstituteParamForNewOrCurrent ( parsetree, relid )
  1073.      List parsetree;
  1074.      ObjectId relid;
  1075. {
  1076.     List i = NULL;
  1077.     Name getAttrName();
  1078.  
  1079.     /*
  1080.      * sanity check...
  1081.      */
  1082.     if (relid==NULL) {
  1083.     elog(WARN, "SubstituteParamForNewOrCurrent: wrong argument rel");
  1084.     }
  1085.  
  1086.     foreach ( i , parsetree ) {
  1087.     List temp = CAR(i);
  1088.     if ( temp && IsA (temp,Var) ) {
  1089.         Name attrname = NULL;
  1090.         AttributeNumber attrno;
  1091.  
  1092.  
  1093.         if ( get_varno((Var)temp) == 1) {
  1094.         /* replace with make_param(old) */
  1095.         attrname = get_attname(relid, get_varattno((Var)temp));
  1096.         attrno = get_varattno((Var)temp);
  1097.         CAR(i) = (List)MakeParam (PARAM_OLD,
  1098.                     attrno,
  1099.                     attrname,
  1100.                     get_vartype((Var)temp),
  1101.                     (List) NULL);
  1102.         } 
  1103.         if ( get_varno((Var)temp) == 2) {
  1104.         /* replace with make_param(new) */
  1105.         attrname = get_attname(relid, get_varattno((Var)temp));
  1106.         attrno = get_varattno((Var)temp);
  1107.         CAR(i) = (List)MakeParam(PARAM_NEW,
  1108.                    attrno,
  1109.                    attrname,
  1110.                    get_vartype((Var)temp),
  1111.                    (List) NULL);
  1112.         }
  1113.     } 
  1114.     if (  temp && temp->type == PGLISP_DTPR ) 
  1115.       SubstituteParamForNewOrCurrent ( temp , relid );
  1116.     }
  1117. }
  1118.  
  1119.